{
Traviesadora beta 0.2.0.13.33 (30.11.2008)
LastMod: 03.12.2008 by Prof1983

Copyright 2008, travieorama@googlemail.com

This file is part of the taviesadora project

taviesadora is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

taviesadora is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
}
unit CryptKeyLibrary;

interface

uses
  Classes, Service, SysUtils, LbCipher, LbUtils, LbClass, LbAsym, LbDSA, CryptFunctions;

const
  LIB_ENCRYPTION_KEY_SIZE = 256;
  LIB_ENCRYPTION_KEY_ROUNDS = 10000;

type
  TKeyRec = record
    PartnerID: string;
    SessionKey: string;
    Date: TDateTime;
  end;
  PKeyRec = ^TKeyRec;
  TCryptKeyLib = class
  public
    constructor Create(ownjid, FileName: string; IniFile: TConfigFile);
    destructor Destroy; override;
    function LoadKeyLib(PW: string): Boolean;
    procedure ModifyKey(PartnerID: string; SessionKey: TMemoryStream);
    procedure ModifyKeyBuf(PartnerID: string; Buf: array of Char; BufSize: Integer);
    procedure Addkey(PartnerID: string; SessionKey: TMemoryStream);
    procedure DelKey(PartnerID: string);
    function getKeyLibRecords(extra: string): string;
    function GetKeyDate(PartnerID: string): TDateTime;
    function GetSessionKey(PartnerID: string): TMemoryStream;
    function GetSessionKeyBuf(PartnerID: string; Buf: array of Char; BufSize: Integer): Integer;
    function GetSessionKeyHex(PartnerID: string): string;
    function GetSessionMD5(PartnerID: string): string;
    function GetSessionSHA1(PartnerID: string): string;
    function KeyExists(PartnerID: string): Boolean;
    procedure SetPW(PW: string);
  private
    iniFile: TConfigFile;
    keylib: TList;
    ownjid: string;
    filename: string;
    Loaded: Boolean;
    Modified: Boolean;
    PWOK: Boolean;
    PW: string;
    procedure LoadFromFile(PW: string);
    procedure SaveToFile();
    procedure ClearLib();
    procedure DelLibItem(i: Integer);
    function SearchLibItem(jid: string): Integer;
    procedure NewKey(PartnerID: string; SessionKey: TMemoryStream);
    procedure NewKeyBuf(PartnerID: string; Buf: array of Char; BufSize: Integer);
    function CheckGoodDecryption(s: string): Boolean;
    function DecryptLibFile(libFile: TStringList): Boolean;
    function GetMD5String(s: string): string;
    procedure EncryptLibFile(libFile: TStringList);
  end;

implementation

{ TCryptKeyLib }

function TCryptKeyLib.SearchLibItem(jid:string): integer;
var
  i:integer;
  ch:PKeyRec;
begin
  result := -1;
  jid := lowercase(jid);
  for i := 0 to keylib.Count-1 do begin
    ch := keylib[i];
    if lowercase(ch.PartnerID) = jid then begin
      result := i;
      break;
    end;
  end;
end;

procedure TCryptKeyLib.DelLibItem(i: integer);
var
  ch:PKeyRec;
  n:integer;
begin
  if (i > -1) and (i<keylib.Count) then begin
    ch := keylib[i];
    for n := 1 to length(ch.SessionKey) do begin
      ch.SessionKey[n] := 'x';  //deleting the key content from memory
    end;
    dispose(ch);
    keylib.delete(i);
  end;
  Modified := true;
end;

procedure TCryptKeyLib.ClearLib;
var
  i:integer;
begin
  for i := 0 to keylib.Count-1 do begin
    DelLibItem(0);
  end;
end;

constructor TCryptKeyLib.create(ownjid,filename: string;iniFile:TConfigFile);
begin
  inherited create;
  self.ownjid  :=ownjid;
  self.filename := filename;
  Keylib := TList.Create;
  Loaded := false;
  Modified := false;
  self.iniFile := iniFile;
  PW := '';
  //LoadfromFile(PW);
end;

destructor TCryptKeyLib.destroy;
var
  i :integer;
begin
  SaveToFile;
  ClearLib;
  for i := 1 to length(PW) do pw[i] := '_';
  keylib.Free;
  inherited destroy;
end;

function TCryptKeyLib.GetMD5String(s:string):string;
var
  md5:TMD5Digest;
begin
  StringHashMD5(md5, s);
  result := BufferToHex(md5, SizeOf(md5));
end;

function TCryptKeyLib.CheckGoodDecryption(s:string):boolean;
var
  s1,s2:string;
begin
  s1 := GetMD5String(s);
  s2 := iniFile.GetKeyLibHash(ExtractFileName(filename));
  result := (s1=s2) or (s2 = '');
end;

function TCryptKeyLib.DecryptLibFile(libFile: TStringList): Boolean;
var
  lbrjdl: TLbRijndael;
  key: array[0..(LIB_ENCRYPTION_KEY_SIZE div 8) -1] of char;
  keytxt: array[0..(LIB_ENCRYPTION_KEY_SIZE div 4) ] of char;
  keys: string;
  i: Integer;
  //l: Integer;
  res: string;
begin
  result := true;
  res := uppercase(libFile.Text);
  //if PW='' then exit;
  i := 1;
  while i <= length(res) do begin
    if not (((ord(res[i])<=ord('F')) and (ord(res[i])>=ord('A'))) or
            ((ord(res[i])<=ord('9')) and (ord(res[i])>=ord('0'))) or
            ((ord(res[i])<=ord('!')))) then
      exit;                                           //Seems not to be encrypted
    if (ord(res[i])<=ord('!'))then
      delete(res,i,1)
    else
      inc(i);
  end;
  if res = '' then exit;
  lbrjdl := TLbRijndael.Create(nil);
  try
    case LIB_ENCRYPTION_KEY_SIZE of
      128: lbrjdl.KeySize := ks128;
      192: lbrjdl.KeySize := ks192;
      256: lbrjdl.KeySize := ks256;
    end;
    lbrjdl.CipherMode := cmCBC;
    for i := 0 to high(keytxt) do keytxt[i]:= #0;
    keys := KeyStrengthProt1(PW,LIB_ENCRYPTION_KEY_ROUNDS);
    {l := sizeof(keytxt)-1;
    if length(keys)-1<l then
      l := length(keys)-1;}
    for i := 0 to high(keytxt) do keytxt[i]:= keys[i+1];
    HexToBin(keytxt,key,sizeof(key));
    lbrjdl.SetKey(key);
    try
      res := DecryptRJDLProt1(res,lbrjdl);
      result := CheckGoodDecryption(res);
      if result then
        libFile.Text := res;
    except
      on EConvertError do begin
        result := true;
      end;
    end;
  finally
    for i := 0 to high(key) do key[i]:= #0;
    for i := 0 to high(keytxt) do keytxt[i]:= #0;
    for i := 1 to length(keys) do keys[i]:= '_';
    lbrjdl.SetKey(key);
    lbrjdl.Free;
  end;
end;

procedure TCryptKeyLib.EncryptLibFile(libFile:TStringList);
var
  lbrjdl: TLbRijndael;
  key: array[0..(LIB_ENCRYPTION_KEY_SIZE div 8) -1] of char;
  keytxt: array[0..(LIB_ENCRYPTION_KEY_SIZE div 4) ] of char;
  keys: string;
  i: Integer;
  //l: Integer;
  res: string;
begin
  iniFile.SetKeyLibHash(ExtractFileName(filename),GetMD5String(libFile.Text));
  if PW = '' then exit;
  lbrjdl := TLbRijndael.Create(nil);
  try
    case LIB_ENCRYPTION_KEY_SIZE of
      128: lbrjdl.KeySize := ks128;
      192: lbrjdl.KeySize := ks192;
      256: lbrjdl.KeySize := ks256;
    end;
    lbrjdl.CipherMode := cmCBC;
    for i := 0 to high(keytxt) do keytxt[i]:= #0;
    keys := KeyStrengthProt1(PW,LIB_ENCRYPTION_KEY_ROUNDS);
    {l := sizeof(keytxt)-1;
    if length(keys)-1<l then
      l := length(keys)-1;}
    for i := 0 to high(keytxt) do keytxt[i]:= keys[i+1];
    HexToBin(keytxt,key,sizeof(key));
    lbrjdl.SetKey(key);
    try
      res := EncryptRJDLProt1(libFile.Text,lbrjdl);
      libFile.Text := res;
    except
      on EConvertError do begin
      end;
    end;
  finally
    for i := 0 to high(key) do key[i]:= #0;
    for i := 0 to high(keytxt) do keytxt[i]:= #0;
    for i := 1 to length(keys) do keys[i]:= '_';
    lbrjdl.SetKey(key);
    lbrjdl.Free;
  end;
end;

procedure TCryptKeyLib.LoadFromFile(PW:string);
var
  LibFile:TStringList;
  i:integer;
  s,t:string;
  kr:PKeyRec;
begin
  self.PW := PW;
  PWOK := true;
  LibFile := TStringList.create;
  try
    ClearLib;
    if fileexists(filename) then begin
      LibFile.LoadFromFile(filename);
      PWOK := DecryptLibFile(LibFile);
      if PWOK then begin
        for i := 0 to LibFile.Count-1 do begin
          s := LibFile[i];                 //19.03.2007;jabber@jabber.com;AE223879823EF9C32312313312
          if s='' then continue;
          try
            t := s;
            new(kr);
            delete(t,pos(';',t),length(t));
            kr.Date := StrToDateTime(t);
            delete(s,1,pos(';',s));
            t := s;
            delete(t,pos(';',t),length(t));
            kr.PartnerID := t;
            delete(s,1,pos(';',s));
            kr.SessionKey := s;
            keylib.Add(kr);
          except On EConvertError do begin
                end;
          end;
        end;
        Loaded := true;
        Modified := false;
      end;
    end;
  finally
    LIbFile.Free;
  end;
end;

function TCryptKeyLib.LoadKeyLib(PW:string): boolean;
begin
  LoadFromFile(PW);
  result := PWOK;
end;


procedure TCryptKeyLib.SaveToFile;
var
  LibFile:TStringList;
  i:integer;
  s,t:string;
  path:string;
  kr:PKeyRec;
begin
  if not Modified then exit;
  LibFile := TStringList.create;
  try

    if not loaded then begin         //this happens if the user didnt know the pasword
      if fileexists(filename) then begin
        s := ExtractFileName(filename);
        i := 0;
        repeat
          t := inttostr(i)+s;
          inc(i);
        until not FileExists(ExtractFilePath(filename)+t);
        RenameFile(filename,t);
      end;
    end;
    for i := 0 to keylib.Count-1 do begin
      kr := keylib[i];                 //19.03.2007;jabber@jabber.com;AE223879823EF9C32312313312
      s := DateTimeToStr(kr.Date)+';'+kr.PartnerID+';'+kr.SessionKey;
      LibFile.Add(s);
    end;
    if pw = '' then
      iniFile.SetKeyLibPWState(false)
    else
      iniFile.SetKeyLibPWState(true);
    EncryptLibFile(LibFile);
    path := ExtractFilePath(filename);
    if (DirectoryExists(path) = false) then
        ForceDirectories(path);
    if (DirectoryExists(path)) then begin
      LibFile.SaveToFile(filename);
      Modified := false;
    end;
    //Loaded := true;
  finally
    LIbFile.Free;
  end;
end;


function TCryptKeyLib.GetSessionKeyHex(PartnerID: string): string;
var
  i:integer;
  kr:PKeyRec;
begin
  i := SearchLibItem(PartnerID);
  if i > -1 then begin
    kr := keylib[i];
    result := kr.SessionKey
  end else
    result := '';
end;

function TCryptKeyLib.GetSessionKeyBuf(PartnerID: string;
  Buf: array of char; BufSize: integer):integer;
var
  i:integer;
  s:string;
begin
  s := GetSessionKeyHex(PartnerID);
  if s<>'' then begin
    i := length(s);
    i := i div 2;                           //i is the length of the key
    if i > BufSize then begin
      i := BufSize;
      result := -BufSize;
    end else begin
      result := i;
    end;
    hextobin(PCHAR(s),buf,i);
  end else
    result := 0;
end;



function TCryptKeyLib.GetSessionKey(PartnerID: string): TMemoryStream;
var
  i:integer;
  buf:array[0..511]of char;
begin
  i := GetSessionKeyBuf(PartnerID,buf,sizeof(buf));
  result := TMemoryStream.Create;
  result.Write(buf,i);
end;

function TCryptKeyLib.GetKeyDate(PartnerID: string): TDateTime;
var
  i:integer;
  kr:PKeyRec;
begin
  i := SearchLibItem(PartnerID);
  if i > -1 then begin
    kr := keylib[i];
    result := kr.Date;
  end else
    result := 0;
end;

function TCryptKeyLib.KeyExists(PartnerID: string): boolean;
begin
  result := SearchLibItem(PartnerID)>-1;
end;

procedure TCryptKeyLib.NewKeyBuf(PartnerID: string; Buf: array of char; BufSize: integer);
var
  //ms: TMemoryStream;
  i: Integer;
  kr: PKeyRec;
  cbuf: array[0..1023]of char;
begin
  for i := 0 to high(cbuf) do cbuf := #0;
  i := SearchLibItem(PartnerID);
  if i > -1 then
  begin
    kr := keylib[i];
  end
  else
  begin
    new(kr);
    keylib.Add(kr);
    kr.PartnerID := PartnerID;
  end;
  BinToHex(buf,cbuf,BufSize);
  kr.SessionKey := cbuf;
  kr.Date := now;
  Modified := true;
end;

procedure TCryptKeyLib.NewKey(PartnerID: string; SessionKey: TMemoryStream);
var
  //ms: TMemoryStream;
  i: Integer;
  buf: array[0..511]of char;
begin
  SessionKey.Seek(0,soFromBeginning	);
  i := SessionKey.Read(buf,sizeof(buf));
  NewKeyBuf(PartnerID,buf,i);
  Modified := true;
end;

procedure TCryptKeyLib.Addkey(PartnerID: string;
  SessionKey: TMemoryStream);
begin
  NewKey(PartnerID,SessionKey);
end;

procedure TCryptKeyLib.ModifyKey(PartnerID: string;
  SessionKey: TMemoryStream);
begin
  NewKey(PartnerID,SessionKey);
end;

procedure TCryptKeyLib.ModifyKeyBuf(PartnerID: string; Buf: array of char;
  BufSize: integer);
begin
  NewKeyBuf(PartnerID,buf,BufSize);
end;

procedure TCryptKeyLib.DelKey(PartnerID: string);
begin
  DelLibItem(SearchLibItem(PartnerID));
end;

function TCryptKeyLib.GetSessionMD5(PartnerID: string): string;
var
  md5:TMD5Digest;
begin
  StringHashMD5(md5, GetSessionKeyHex(PartnerID));
  result := BufferToHex(md5, SizeOf(md5));
end;


function TCryptKeyLib.GetSessionSHA1(PartnerID: string): string;
var
  sha1:TSHA1Digest;
begin
  StringHashSHA1(sha1, GetSessionKeyHex(PartnerID));
  result := BufferToHex(sha1, SizeOf(sha1));
end;





function TCryptKeyLib.getKeyLibRecords(extra:string): string;
var
  i:integer;
  kr:PKeyRec;
begin
  result := '';
  for i := 0 to keylib.Count-1 do begin
    kr := keylib[i];
    if result <> '' then
      result := result+sep;
    result := result+extra+sep+DateTimeToStr(kr.Date)+sep+kr.PartnerID;
  end;
end;

procedure TCryptKeyLib.SetPW(PW: string);
begin
  self.PW := pw;
  Modified := true;
end;

end.
